home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / yerk / mps231ss.hqx / Mops source / Module source / MenuMod.txt < prev    next >
Text File  |  1993-01-27  |  4KB  |  140 lines
  1. \ Menu class.
  2. \ Sept 90  mrh  item# anomalies fixed
  3.  
  4.  
  5. :class    MENU    super{ x-array }
  6.  
  7.     int    RESID        \ Resource ID of this menu
  8.     var    MHNDL        \ Handle to menu heap storage
  9.  
  10. :m ID:            inline{ get: resID}  get: resID  ;m
  11. :m PUTRESID:    inline{ put: resID}  put: resID  ;m
  12.  
  13. :m HANDLE:
  14.     inline{ get: mHndl}
  15.     get: mhndl  ;m
  16.  
  17. :m INIT:    \ ( xt1 ... xtN N resID -- )
  18.     put: resID  put: super  ;m
  19.  
  20. :m NEW:        \ ( addr len -- )  Allocates menu with title.
  21.             \ Non-resource-based.
  22.     str255  >r  0  int: resid  r>  call NewMenu
  23.     put: Mhndl  ;m
  24.  
  25. \ GetNew: and Release: are used if the menu is resource-based.
  26.  
  27. :m GETNEW:
  28.     0  int: resid  call GetRMenu  dup 0= ?error 127
  29.     put: mHndl  ;m
  30.  
  31. :m RELEASE:
  32.     get: mHndl  call ReleaseResource  ;m
  33.  
  34.  
  35. :m INSERT:    \ Inserts the menu in the menu bar.
  36.     get: Mhndl  word0  call InsertMenu  ;m
  37.  
  38.  
  39. :m NORMAL:    \ Removes hiliting on ALL menus!
  40.     word0  call HiliteMenu  ;m
  41.  
  42. :m ENABLE:    \ Enables a whole menu.
  43.     get: Mhndl  word0  call EnableItem  call DrawMenuBar  ;m
  44.  
  45. :m DISABLE:    \ Greys and disables a whole menu.
  46.     get: Mhndl  word0  call DisableItem  call DrawMenuBar  ;m
  47.  
  48.  
  49. \ Methods dealing with individual menu items.  We index from zero, as normal
  50. \ in Mops.  BUT NOTE that this is different from the Toolbox convention
  51. \ relating to menu items.
  52.  
  53. :m GETITEM:        \ ( item# -- addr len )  Gets string for item#
  54.     get: mhndl  swap 1+ makeint
  55.     buf255  call GetItem  buf255  count  ;m
  56.  
  57. :m PUTITEM:  { item# addr len -- }    \ Replaces menu item string
  58.     get: mhndl  item# 1+ makeint  addr len str255
  59.     call SetItem  ;m
  60.  
  61. :m INSERTITEM:  { item# addr len -- }    \ Inserts a new item, after item#.
  62.     get: mhndl  addr len str255  item# 1+ makeint
  63.     call InsMenuItem  ;m
  64.  
  65. :m DELETEITEM:    \ ( item# -- )  Deletes the item.
  66.     get: mhndl  swap 1+ makeint  call DelMenuItem  ;m
  67.  
  68.  
  69. :m ADD:        \ ( addr len -- )  Appends a menu item
  70.     str255  get: Mhndl
  71.     swap  call AppendMenu  ;m
  72.  
  73. :m ADDITEM:    add: self  ;m        \ Just for naming consistency
  74.  
  75. :m ADDRES:    \ ( type -- )  Adds all resources of a type
  76.     get: Mhndl swap  call AddResMenu  ;m
  77.  
  78.  
  79. :m ENABLEITEM:    \ ( item# -- )  Enables a menu item
  80.     get: Mhndl swap 1+ makeint  call EnableItem  ;m
  81.  
  82. :m DISABLEITEM:    \ ( item# -- )  Greys and disables an item
  83.     get: Mhndl swap 1+ makeint  call DisableItem  ;m
  84.  
  85.  
  86. :m OPENDESK:    \ ( item# -- )  Opens the desk accy for item#
  87.     savePort  getitem: self  2drop
  88.     word0  buf255  call OpenDeskAcc  word0 drop  restPort  ;m
  89.  
  90.  
  91. :m EXEC:    \ ( item# -- )  Executes the code for a menu item.
  92.  
  93. \ Menu handlers will have item# on the stack when they execute, and they
  94. \ should leave it there.  This way, they can ignore it if they want to,
  95. \ which will be the most common situation.
  96. \ If the item# is too great for this menu, we actually execute the last
  97. \ item rather than give an error.  This allows us to save memory 
  98. \ when a menu may have dozens of identical items such as fonts or DAs, as
  99. \ can happen with Font/DA Juggler or Suitcase.  But of course we don't
  100. \ alter the item# on the stack.
  101.  
  102.     dup  limit 1- min  exec: super  drop  normal: self  ;m
  103.  
  104.  
  105. :m CHECK:    \ ( item# -- )
  106.     get: Mhndl  swap 1+ makeInt  w 256
  107.     call CheckItem  ;m
  108.  
  109. :m UNCHECK:    \ ( item# -- )
  110.     get: Mhndl  swap 1+ makeInt  word0
  111.     call CheckItem  ;m
  112.  
  113. ;class
  114.  
  115.  
  116. \ Subclass AppleMenu facilitates standard Apple Menu support, by filling
  117. \ the menu with all the DAs at GetNew: time.
  118.  
  119. :class  APPLEMENU  super{ menu }
  120.  
  121. :m GETNEW:
  122.     getnew: super
  123.     'type DRVR  addRes: self  ;m
  124.  
  125. ;class
  126.  
  127.  
  128. \ Subclass EditMenu facilitates standard DA support.  The EXEC: method
  129. \ first calls SystemEdit so any active DA gets a go at it.
  130.  
  131. :class  EDITMENU  super{ menu }
  132.  
  133. :m EXEC:  { item# -- }
  134.     word0  item# makeint  call SystemEdit  i->l
  135.     IF        normal: self
  136.     ELSE    item#  exec: super
  137.     THEN  ;m
  138.  
  139. ;class
  140.